問題の説明
セルからデータを抽出し、セルをアルファベット順に並べ替えるにはどうすればよいですか? (How do I extract data from a cell and order the cells alphabetically?)
Excel の変更を自動化しようとしています。
プロセスは次のように機能します:
- Excel リストが作成されます。
- 必要です従業員が手動で処理します (画像の削除、アルファベット順など)。
- リストは csv ファイルに変換されます。
- CSV はアップロードされて処理されます。
このプロセスを可能な限り自動化したいと考えています。私は VBA や Excel マクロを使った経験がありません。
これまでのところ、いくつかの異なるスクリプトを混ぜ合わせて途中まで進めることができましたが、これら 2 つを得ることができませんでした。機能が働いています。上部 (まだ下部ではない) の膨張をすべて削除し、空の行を削除し、未使用の列を削除することができました。
プライバシー上の理由から、シート自体の内容を投稿することはできませんが、シートの構造は次のようになります:
| Name | Cost |
| Mark Renner (mare) | €200,‑ |
質問
4 文字のコードを抽出してフル ネームに置き換えたいので、4 文字のコードだけがセルに残ります。
また、リストをアルファベット順に並べ替えたいと思います。シートの範囲は日ごとに異なるため、固定量のセルはありません。
このシートには他に心配する必要はありません。必要に応じて、さらに情報を提供できます。
誰かがこれを手伝ってくれたら、とても助かります。
よろしくお願いします!
編集:
さらに要求された情報を次に示します。
これは、すべての肥大化を取り除くために現在使用しているスクリプトです。完璧ではないと思いますが、今のところうまくいきます。
Sub run()
Call testvba
Call DeleteRowWithContents
Call usedR
End Sub
Sub testvba()
Dim i As Integer
For i = 1 To 21
Rows(1).EntireRow.Delete
Next i
For i = 1 To 10
Columns(4).EntireColumn.Delete
Next i
Dim shape As Excel.shape
For Each shape In ActiveSheet.Shapes
shape.Delete
Next
End Sub
Sub DeleteRowWithContents()
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step ‑1
If (Cells(i, "A").Value) = "User" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
Sub usedR()
ActiveSheet.UsedRange.Select
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step ‑1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub `
スクリプトの前の表:
解決策:
4 文字のコードです。
最終的にこのコード行を使用して、レコードをアルファベット順に並べ替えました:
Sub Alpha()
Dim fromRow As Integer
Dim toRow As Integer
fromRow = 1
toRow = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Rows(fromRow & ":" & toRow).Sort Key1:=ActiveSheet.Range("A:A"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End Sub
リファレンスソリューション
方法 1:
To get the 4 letter code you can search for the "(" and cut the string down
Something like this will get you to the code, you could use regedit but that seems like overkill
Sub ReplaceName()
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For r = 2 to LastRow 'assumes data starts in row 2 with header in row 1
if Cells(r,1).value = "" then goto Nextr 'skips blanks
CurrentString = Cells(r,1).value 'assumes the names are in column 1
'At this point CurrentString = "Mark Renner (mare)"
CurrentString = Right(CurrentString,len(CurrentString)‑instr(1,CurrentString,"("))
'At this point CurrentString = "mare)"
CurrentString = left(CurrentString,instr(1,CurrentString,")")‑1)
'At this point CurrentString = "mare"
Cells(r,1).value = CurrentString
Nextr:
Next r
End Sub
As far as putting it in alphabetical order, there are two ways that come to mind
- Move all of the values into an array then iterate through the array and sort them
- Create a filtered range and filter is
the second option is MUCH easier, and for what you're doing I think it's probably fine. It'll look something like this:
With data that looks like this (in cells A1 to B6):
Name Cost
Tom 149
Dick 272
Harry 186
Moe 292
Larry 377
I'd do something like this:
Sub SortAlpha()
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range(Cells(1,1),Cells(LastRow,2)).select 'selects the data and headers
Selection.AutoFilter 'Adds Filter
ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Clear
Range(Cells(1, 1), Cells(LastRow, 1)).Select 'selects name column
'filters alpha
ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Selection _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range(Cells(1,1),Cells(LastRow,2)).select 'selects the data and headers
Selection.AutoFilter 'Removes Filter
End Sub
That'll Give you this:
Name Cost
Dick 272
Harry 186
Lary 377
Moe 292
Tom 149
As Far as cleaning the data I usually do a couple of things when I have data tables that are really messy
Start Here:
1. iterate through the range and remove all merges
2. unwrap all of the text
3. delete all pictures
4. Delete any blank Rows or columns
I like this code for finding the last row:
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
You can modify it to find the last column
LastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Then you can loop through your whole sheet cell by cell, or as a range Cell by Cell: (I use this to unmerge the cells ‑ can be slow)
For r = 1 to LastRow
For c = 1 to LastCol
'Do Stuff
Cells(r,c).UnMerge 'or Cells(r,c).MergeCells = False
Next c
Next r
or as a range: I use this for unwrapping the text
Range(Cells(1,1),Cells(LastRow,LastCol)).WrapText = False
To delete the pictures I use this code: Deleting pictures with Excel VBA
Dim shape As Excel.shape
For Each shape In ActiveSheet.Shapes
shape.Delete
Next
This seems like it would work for saving the csv if you wanted to automate that also:
Saving excel worksheet to CSV files with filename+worksheet name using VB
I'd re‑resize all of your rows and columns, rows to their default and columns to the fit: Unfortunately I haven't found a great way to do the rows without a range string so my code is a little messy:
RowRange = "1:" & LastRow
Rows(RowRange).RowHeight = 12.75
Columns are about the same, but worse because they're not numbered
ColStart = Cells(1,1).Address
ColEnd = Cells(1,LastCol).Address
ColStart = left(ColStart,len(ColStart)‑1)
ColEnd = left(ColEnd,len(ColEnd)‑1)
ColStart = Replace(ColStart,"$","")
ColEnd = Replace(ColEnd,"$","")
ColRange = ColStart & ":" & ColEnd
Columns(ColRange).EntireColumn.AutoFit
you could alternatively just make it significantly large, but where's the fun in that?
Columns("A:ZZ").EntireColumn.AutoFit